Introduction

Prepare the data

# Load data ####
data(ge_cgh_locIGR, package = "gliomaData")
A <- ge_cgh_locIGR$multiblocks
Loc <- factor(ge_cgh_locIGR$y)
levels(Loc) <- colnames(ge_cgh_locIGR$multiblocks$y)
ncomp <- rep(1, length(A))
# rgcca algorithm using the dual formulation for X1 and X2 
# and the dual formulation for X3
A[[3]] = A[[3]][, -3]
C <-  matrix(c(0, 0, 1, 0, 0, 1, 1, 1, 0), 3, 3)
dimnames(C) <- list(names(A), names(A))
C
##     GE CGH y
## GE   0   0 1
## CGH  0   0 1
## y    1   1 0

Preparing the taus

Testing the tau effect on the AVE

(min_shrinkage <- sapply(A, function(x) {
  1 / sqrt(ncol(x))
}))
##          GE         CGH           y 
## 0.007980361 0.028524895 0.707106781
taus <- lapply(min_shrinkage, seq, to = 1, length.out = 10)
taus.combn <- expand.grid(taus)
keep <- apply(taus.combn, 1, function(x){sum(x != 0)})
taus.combn <- taus.combn[keep >= 2, ]
# Add the example values at the bottom
taus.combn <- rbind(taus.combn, c(.071,.2, 1))
head(taus.combn)
##            GE       CGH         y
## 1 0.007980361 0.0285249 0.7071068
## 2 0.118204765 0.0285249 0.7071068
## 3 0.228429169 0.0285249 0.7071068
## 4 0.338653574 0.0285249 0.7071068
## 5 0.448877978 0.0285249 0.7071068
## 6 0.559102382 0.0285249 0.7071068

Calculate the AVE values

We iterate over the list of taus

out <- sapply(seq_len(nrow(taus.combn)), function(x){
  result.sgcca <- sgcca(A, C, c1 = taus.combn[x, ], ncomp = ncomp, 
                        scheme = "centroid", verbose = FALSE)
  unlist(result.sgcca$AVE[c("AVE_inner", "AVE_outer")])
})
centroid <- cbind.data.frame(t(out), taus.combn)
saveRDS(centroid, "centroid_tau.RDS")
out <- sapply(seq_len(nrow(taus.combn)), function(x){
  result.sgcca <- sgcca(A, C, c1 = taus.combn[x, ], ncomp = ncomp, 
                        scheme = "factorial", verbose = FALSE)
  unlist(result.sgcca$AVE[c("AVE_inner", "AVE_outer")])
})
factorial <- cbind.data.frame(t(out), taus.combn)
saveRDS(factorial, "factorial_tau.RDS")
out <- sapply(seq_len(nrow(taus.combn)), function(x){
  result.sgcca <- sgcca(A, C, c1 = taus.combn[x, ], ncomp = ncomp, 
                        scheme = "horst", verbose = FALSE)
  unlist(result.sgcca$AVE[c("AVE_inner", "AVE_outer")])
})
horst <- cbind.data.frame(t(out), taus.combn)
saveRDS(horst, "horst_tau.RDS")
library("dplyr")
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
horst %>% 
  # group_by(GE, CGH, y) %>% add_count() %>% 
  filter(AVE_inner == max(AVE_inner))
##   AVE_inner  AVE_outer        GE       CGH y
## 1 0.6430402 0.07189818 0.1182048 0.4602916 1

Plot the result

p <- ggplot(centroid)
p1 <- p + geom_point(aes(GE, AVE_inner, col = "inner")) + ylab("AVE") +
  geom_smooth(aes(GE, AVE_inner, col = "inner")) +
  geom_smooth(aes(GE, AVE_outer, col = "outer")) +
  geom_point(aes(GE, AVE_outer, col = "outer")) + guides(col = FALSE)
p2 <- p + geom_point(aes(CGH, AVE_inner, col = "inner")) + ylab("") +
  geom_smooth(aes(CGH, AVE_inner, col = "inner")) +
  geom_smooth(aes(CGH, AVE_outer, col = "outer")) +
  geom_point(aes(CGH, AVE_outer, col = "outer")) + guides(col = FALSE)
p3 <- p + geom_point(aes(y, AVE_inner, col = "inner")) + ylab("") +
  geom_smooth(aes(y, AVE_inner, col = "inner")) +
  geom_smooth(aes(y, AVE_outer, col = "outer")) +
  geom_point(aes(y, AVE_outer, col = "outer")) + labs(col = 'AVE type') 

q <- p + geom_count(aes(AVE_outer, AVE_inner)) + 
  xlab("AVE outer") + ylab("AVE inner")

(p1 + p2 + p3) / (q)
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'

p <- ggplot(factorial)
p1 <- p + geom_point(aes(GE, AVE_inner, col = "inner")) + ylab("AVE") +
  geom_smooth(aes(GE, AVE_inner, col = "inner")) +
  geom_smooth(aes(GE, AVE_outer, col = "outer")) +
  geom_point(aes(GE, AVE_outer, col = "outer")) + guides(col = FALSE)
p2 <- p + geom_point(aes(CGH, AVE_inner, col = "inner")) + ylab("") +
  geom_smooth(aes(CGH, AVE_inner, col = "inner")) +
  geom_smooth(aes(CGH, AVE_outer, col = "outer")) +
  geom_point(aes(CGH, AVE_outer, col = "outer")) + guides(col = FALSE)
p3 <- p + geom_point(aes(y, AVE_inner, col = "inner")) + ylab("") +
  geom_smooth(aes(y, AVE_inner, col = "inner")) +
  geom_smooth(aes(y, AVE_outer, col = "outer")) +
  geom_point(aes(y, AVE_outer, col = "outer")) + labs(col = 'AVE type') 

q <- p + geom_count(aes(AVE_outer, AVE_inner)) + 
  xlab("AVE outer") + ylab("AVE inner")

(p1 + p2 + p3) / (q)
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'

p <- ggplot(horst)
p1 <- p + geom_point(aes(GE, AVE_inner, col = "inner")) + ylab("AVE") +
  geom_smooth(aes(GE, AVE_inner, col = "inner")) +
  geom_smooth(aes(GE, AVE_outer, col = "outer")) +
  geom_point(aes(GE, AVE_outer, col = "outer")) + guides(col = FALSE)
p2 <- p + geom_point(aes(CGH, AVE_inner, col = "inner")) + ylab("") +
  geom_smooth(aes(CGH, AVE_inner, col = "inner")) +
  geom_smooth(aes(CGH, AVE_outer, col = "outer")) +
  geom_point(aes(CGH, AVE_outer, col = "outer")) + guides(col = FALSE)
p3 <- p + geom_point(aes(y, AVE_inner, col = "inner")) + ylab("") +
  geom_smooth(aes(y, AVE_inner, col = "inner")) +
  geom_smooth(aes(y, AVE_outer, col = "outer")) +
  geom_point(aes(y, AVE_outer, col = "outer")) + labs(col = 'AVE type') 

q <- p + geom_count(aes(AVE_outer, AVE_inner)) + 
  xlab("AVE outer") + ylab("AVE inner")

(p1 + p2 + p3) / (q)
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'

Session Info

## Session info -------------------------------------------------------------
##  setting  value                       
##  version  R version 3.5.0 (2018-04-23)
##  system   i686, linux-gnu             
##  ui       X11                         
##  language en_US                       
##  collate  en_US.UTF-8                 
##  tz       Europe/Madrid               
##  date     2018-07-18
## Packages -----------------------------------------------------------------
##  package    * version date       source                              
##  assertthat   0.2.0   2017-04-11 CRAN (R 3.5.0)                      
##  backports    1.1.2   2017-12-13 CRAN (R 3.5.0)                      
##  base       * 3.5.0   2018-04-23 local                               
##  bindr        0.1.1   2018-03-13 CRAN (R 3.5.0)                      
##  bindrcpp   * 0.2.2   2018-03-29 CRAN (R 3.5.0)                      
##  codetools    0.2-15  2016-10-05 CRAN (R 3.5.0)                      
##  colorspace   1.3-2   2016-12-14 CRAN (R 3.5.0)                      
##  compiler     3.5.0   2018-04-23 local                               
##  crayon       1.3.4   2017-09-16 CRAN (R 3.5.0)                      
##  datasets   * 3.5.0   2018-04-23 local                               
##  devtools     1.13.5  2018-02-18 CRAN (R 3.5.0)                      
##  digest       0.6.15  2018-01-28 CRAN (R 3.5.0)                      
##  dplyr      * 0.7.6   2018-06-29 CRAN (R 3.5.0)                      
##  evaluate     0.10.1  2017-06-24 CRAN (R 3.5.0)                      
##  ggplot2    * 3.0.0   2018-07-03 CRAN (R 3.5.0)                      
##  gliomaData * 0.4     2018-07-04 Github (llrs/gliomaData@2b1004c)    
##  glue         1.2.0   2017-10-29 CRAN (R 3.5.0)                      
##  graphics   * 3.5.0   2018-04-23 local                               
##  grDevices  * 3.5.0   2018-04-23 local                               
##  grid         3.5.0   2018-04-23 local                               
##  gtable       0.2.0   2016-02-26 CRAN (R 3.5.0)                      
##  htmltools    0.3.6   2017-04-28 CRAN (R 3.5.0)                      
##  knitr        1.20    2018-02-20 CRAN (R 3.5.0)                      
##  labeling     0.3     2014-08-23 CRAN (R 3.5.0)                      
##  lattice      0.20-35 2017-03-25 CRAN (R 3.5.0)                      
##  lazyeval     0.2.1   2017-10-29 CRAN (R 3.5.0)                      
##  magrittr     1.5     2014-11-22 CRAN (R 3.5.0)                      
##  MASS         7.3-50  2018-04-30 CRAN (R 3.5.0)                      
##  Matrix       1.2-14  2018-04-09 CRAN (R 3.5.0)                      
##  memoise      1.1.0   2017-04-21 CRAN (R 3.5.0)                      
##  methods    * 3.5.0   2018-04-23 local                               
##  mgcv         1.8-24  2018-06-18 CRAN (R 3.5.0)                      
##  munsell      0.5.0   2018-06-12 CRAN (R 3.5.0)                      
##  nlme         3.1-137 2018-04-07 CRAN (R 3.5.0)                      
##  patchwork  * 0.0.1   2018-06-22 Github (thomasp85/patchwork@1d3eccb)
##  pillar       1.3.0   2018-07-14 CRAN (R 3.5.0)                      
##  pkgconfig    2.0.1   2017-03-21 CRAN (R 3.5.0)                      
##  plyr         1.8.4   2016-06-08 CRAN (R 3.5.0)                      
##  purrr        0.2.5   2018-05-29 CRAN (R 3.5.0)                      
##  R6           2.2.2   2017-06-17 CRAN (R 3.5.0)                      
##  Rcpp         0.12.17 2018-05-18 CRAN (R 3.5.0)                      
##  RGCCA      * 2.1.2   2017-05-11 CRAN (R 3.5.0)                      
##  rlang        0.2.1   2018-05-30 CRAN (R 3.5.0)                      
##  rmarkdown    1.10    2018-06-11 CRAN (R 3.5.0)                      
##  rprojroot    1.3-2   2018-01-03 CRAN (R 3.5.0)                      
##  rstudioapi   0.7     2017-09-07 CRAN (R 3.5.0)                      
##  scales       0.5.0   2017-08-24 CRAN (R 3.5.0)                      
##  stats      * 3.5.0   2018-04-23 local                               
##  stringi      1.2.3   2018-06-12 CRAN (R 3.5.0)                      
##  stringr      1.3.1   2018-05-10 CRAN (R 3.5.0)                      
##  tibble       1.4.2   2018-01-22 CRAN (R 3.5.0)                      
##  tidyselect   0.2.4   2018-02-26 CRAN (R 3.5.0)                      
##  tools        3.5.0   2018-04-23 local                               
##  utils      * 3.5.0   2018-04-23 local                               
##  withr        2.1.2   2018-03-15 CRAN (R 3.5.0)                      
##  yaml         2.1.19  2018-05-01 CRAN (R 3.5.0)